﻿Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports System.Reflection

<ToolboxBitmap(GetType(AdvancedListBox), "AdvancedListBoxIcon.ico")>
Public Class AdvancedListBox
	Inherits System.Windows.Forms.ListBox

#Region "Properties"
	Private _IsUpdating As Boolean = False
	Private _IsInvalidated As Boolean = False

	Private _FilterString As String
	<Category("Filter")>
	Public Property FilterString As String
		Get
			Return _FilterString
		End Get
		Set(value As String)
			_FilterString = value

			Reset()
		End Set
	End Property

	Private WithEvents _ItemsObjectCollection As New CustomObjectCollection(Me)
	Public Shadows Property Items As CustomObjectCollection
		Get
			Return _ItemsObjectCollection
		End Get
		Set(value As CustomObjectCollection)
			_ItemsObjectCollection = value
		End Set
	End Property

	Private _FilterItems As Boolean = False
	<Category("Filter")>
	Public Property FilterItems As Boolean
		Get
			If MyBase.DataSource IsNot Nothing Then
				Return False
			End If
			Return _FilterItems
		End Get
		Set(value As Boolean)
			_FilterItems = value

			Reset()

		End Set
	End Property

	Private _OrderByBestMatch As Boolean = False
	<Category("Filter")>
	Public Property OrderByBestMatch As Boolean
		Get
			If MyBase.DataSource IsNot Nothing Then
				Return False
			End If
			Return _OrderByBestMatch
		End Get
		Set(value As Boolean)
			_OrderByBestMatch = value

			Reset()

		End Set
	End Property

	Private _AutoSelectBestMatch As Boolean = False
	<Category("Filter")>
	Public Property AutoSelectBestMatch As Boolean
		Get
			Return _AutoSelectBestMatch
		End Get
		Set(value As Boolean)
			_AutoSelectBestMatch = value

			'we can't select without focusing
			If AutoSelectBestMatch Then
				AutoFocusBestMatch = True
			End If
		End Set
	End Property

	Private _AutoFocusBestMatch As Boolean = False
	<Category("Filter")>
	Public Property AutoFocusBestMatch As Boolean
		Get
			'we can't turn off focus we we want to select
			If AutoSelectBestMatch Then
				Return True
			Else
				Return _AutoFocusBestMatch
			End If
		End Get
		Set(value As Boolean)
			_AutoFocusBestMatch = value
		End Set
	End Property

	Private _AutosizeColumnWidth As Boolean = False
	<Category("Layout")>
	Public Property AutosizeColumnWidth As Boolean
		Get
			Return _AutosizeColumnWidth
		End Get
		Set(value As Boolean)
			_AutosizeColumnWidth = value

			If AutosizeColumnWidth Then
				AutoSetColumnWidth()
			Else
				'reset to default
				MyBase.ColumnWidth = 0
			End If

			'we have to redraw everything
			Reset()
		End Set
	End Property

	''' <summary>
	''' Will return Count of DataSource if one exists,
	''' otherwise will return Count of Items.
	''' In any case, return the smallest value possible.
	''' </summary>
	''' <value></value>
	''' <returns></returns>
	''' <remarks></remarks>
	Public Shadows ReadOnly Property Count As Integer
		Get
			If MyBase.DataSource IsNot Nothing Then
				If MyBase.DataSource.count > MyBase.Items.Count Then
					Return MyBase.Items.Count
				Else
					Return MyBase.DataSource.Count
				End If
			Else
				Return MyBase.Items.Count
			End If

		End Get
	End Property

	Public Shadows Property MultiColumn As Boolean
		Get
			Return MyBase.MultiColumn
		End Get
		Set(value As Boolean)
			MyBase.MultiColumn = value

			'we need to redraw here b/c of the layout change
			Reset()
		End Set
	End Property

	Shadows Property DrawMode As DrawMode
		Get
			Return Windows.Forms.DrawMode.OwnerDrawFixed
		End Get
		Set(value As DrawMode)
			'we aren't going to do anything because we must have this draw mode set
		End Set
	End Property

	<Category("Appearance")>
	Public Property BoldFont As Font = New Font(MyBase.Font, FontStyle.Bold)
#End Region

	Public Sub New()
		MyBase.New()
		MyBase.DrawMode = Windows.Forms.DrawMode.OwnerDrawFixed
	End Sub

#Region "Event Handlers"
	Private Sub AdvancedListBox_BindingContextChanged(sender As Object, e As System.EventArgs) Handles Me.BindingContextChanged
		Reset()
	End Sub

	Private Sub AdvancedListBox_DataSourceChanged(sender As Object, e As System.EventArgs) Handles Me.DataSourceChanged
		Reset()
	End Sub

	Private Sub AdvancedListBox_DisplayMemberChanged(sender As Object, e As System.EventArgs) Handles Me.DisplayMemberChanged
		Reset()
	End Sub

	Public Sub ItemCollectionChangeHandler(sender As Object, e As ListBoxItemEventArgs) Handles _ItemsObjectCollection.ItemAdded
		Reset()
	End Sub

	Private Sub AdvancedListBox_Invalidated(sender As Object, e As System.Windows.Forms.InvalidateEventArgs) Handles Me.Invalidated
		'we can't always set the list items
		If Not _IsInvalidated Then
			_IsInvalidated = True
			_FilterArray = Nothing
			_Phrases = Nothing
			SetListOfItems()
		End If
		'but we can, and should, always check the width of the column
		'this is needed because the items in the box will gradually populate and we need to be able to compensate for that
		If AutosizeColumnWidth Then
			AutoSetColumnWidth()
		End If
	End Sub

	Private Sub CustomDrawItem(sender As Object, e As System.Windows.Forms.DrawItemEventArgs) Handles MyBase.DrawItem
		'if we're painting we're done with the invalidation routine; we're valid again
		_IsInvalidated = False

		' Draw the background of the ListBox control for each item.
		e.DrawBackground()

		'http://msdn.microsoft.com/en-us/library/6xe5hazb(VS.80).aspx
		e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
		e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
		e.Graphics.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality

		' Define the default color of the brush as black.
		Dim myBrush As Brush = Brushes.Black
		Dim myFont As Font = e.Font
		Dim myBoldFont As Font = BoldFont

		Dim phrases As List(Of TextSegment) = GetPhrases(e.Index)

		Dim myBounds As Rectangle = e.Bounds
		For i = 0 To phrases.Count - 1
			Dim phrase As TextSegment
			Dim nextPhrase As TextSegment
			Dim workingFont As Font
			Dim lastPhrase As Boolean = (i = phrases.Count)

			phrase = phrases(i)

			If i < phrases.Count - 1 Then
				nextPhrase = phrases(i + 1)
			End If

			If phrase.IsBold Then
				workingFont = myBoldFont
			Else
				workingFont = myFont
			End If

			If phrase.Text.Length > 0 Then
				e.Graphics.DrawString(phrase.Text, workingFont, myBrush, myBounds, StringFormat.GenericDefault)
				If Not lastPhrase Then
					Dim textWidth As Integer
					If phrase.Width = 0 Then
						textWidth = MeasureDisplayStringWidth(phrase, workingFont, myBrush, myBounds)
						phrase.Width = textWidth
					Else
						textWidth = phrase.Width
					End If

					If phrase.Text(phrase.Text.Length - 1) = " " Then
						'we have to append a space
						Dim spaceSize As SizeF = e.Graphics.MeasureString(" ", myFont)
						textWidth += spaceSize.Width
					End If
					myBounds.X = textWidth
				End If
			End If

		Next

		' If the ListBox has focus, draw a focus rectangle around the selected item.
		e.DrawFocusRectangle()
		'to fix a broken DrawFocusRectangle (I don't know why it sometimes doesn't work)
		If (e.State And DrawItemState.Focus) = DrawItemState.Focus Then
			'the special rectangle size is to fix ghosting of the FocusRectangle
			ControlPaint.DrawFocusRectangle(e.Graphics, New Rectangle(e.Bounds.X, e.Bounds.Y + 1, e.Bounds.Width, e.Bounds.Height - 1))
		End If

	End Sub
#End Region

	Public Shadows Sub BeginUpdate()
		_IsUpdating = True
		MyBase.BeginUpdate()
	End Sub

	Public Shadows Sub EndUpdate()
		'MyBase.EndUpdate() invalidates the control, so keep track of that
		_IsInvalidated = True
		MyBase.EndUpdate()
		_IsUpdating = False

		Reset()
	End Sub

	Public Sub Reset()
		If Not _IsUpdating AndAlso Not _IsInvalidated Then
			Me.Invalidate()
		End If
	End Sub

	'this will get set to nothing if the filter changes
	'since this is called a lot we're saving computational resources here
	Private _FilterArray As List(Of String)
	Private Function GetFilterArray() As List(Of String)
		If _FilterArray Is Nothing AndAlso FilterString IsNot Nothing Then
			_FilterArray = FilterString.Split(" ".ToCharArray, StringSplitOptions.RemoveEmptyEntries).ToList
			_FilterArray.OrderByDescending(Function(x) x.Length)
		End If
		Return _FilterArray
	End Function

	Private _Phrases As Hashtable
	Private Function GetPhrases(Index As Integer) As List(Of TextSegment)
		If _Phrases Is Nothing Then
			_Phrases = New Hashtable
		End If

		Dim myString As String
		'this extra code is so that the designer doesn't break
		'the designer sends null as the index, and that obviously doesn't work
		Dim myIndex As Integer = Index

		'check to see if the index is value before proceeding
		If Count = 0 OrElse myIndex >= Count OrElse myIndex = -1 Then
			'if nothing else, return an empty list
			Return New List(Of TextSegment)
		Else
			myString = GetItemStringByIndex(myIndex)
			If Not _Phrases.ContainsKey(myString) Then
				_Phrases.Add(myString, myString.ToPhrases(GetFilterArray))
			End If

			Return _Phrases(myString)
		End If

	End Function

	Private Function GetPhrases(Text As String) As List(Of TextSegment)
		If _Phrases Is Nothing Then
			_Phrases = New Hashtable
		End If

		If Not _Phrases.ContainsKey(Text) Then
			_Phrases.Add(Text, Text.ToPhrases(GetFilterArray))
		End If

		Return _Phrases(Text)

	End Function

	'this is for filtering
	Private Sub SetListOfItems()
		'we can't change items if this is a bound control
		If MyBase.DataSource Is Nothing AndAlso Not _IsInvalidated Then
			Dim _Items = _ItemsObjectCollection.OfType(Of Object).ToList

			BeginUpdate()
			Dim workingItems As List(Of Object)
			If FilterItems AndAlso Not String.IsNullOrWhiteSpace(FilterString) Then
				workingItems = _Items.Where(Function(x) GetPhrases(x.ToString).Any(Function(y) y.IsBold = True)).AsParallel.ToList
			Else
				workingItems = _Items
			End If

			MyBase.Items.Clear()
			If OrderByBestMatch Then
				MyBase.Items.AddRange(workingItems.OrderByDescending(Function(x) GetPhrases(x.ToString).Where(Function(y) y.IsBold).AsParallel.Count).ToArray)
			Else
				MyBase.Items.AddRange(workingItems.ToArray)
			End If

			EndUpdate()

		End If

		AutoSelectItems()

	End Sub

	Public Sub AutoSelectItems()
		'we have to make sure there are items to select
		If Count > 0 AndAlso (AutoSelectBestMatch OrElse AutoFocusBestMatch) Then
			Dim bestMatchIndex As Integer
			Dim bestMatchesCount As Integer
			For i = 0 To Count - 1
				Dim myString As String = GetItemStringByIndex(i)

				'we want to select the string with the most number of bolded characters
				Dim matches As Integer = GetPhrases(myString).Where(Function(x) x.IsBold).AsParallel.Sum(Function(x) x.Text.Length)
				If matches > bestMatchesCount Then
					bestMatchesCount = matches
					bestMatchIndex = i
				End If
			Next

			If MyBase.SelectedIndices.Contains(bestMatchIndex) Then
				MyBase.SelectedIndex = bestMatchIndex
			Else
				MyBase.SelectedIndex = bestMatchIndex
				'just set focus, don't select it
				If Not AutoSelectBestMatch Then
					If MyBase.SelectedIndices.Contains(bestMatchIndex) Then
						MyBase.SelectedIndices.Remove(bestMatchIndex)
					End If
				End If
			End If
		End If
	End Sub

	Private Sub AutoSetColumnWidth()
		'http://stackoverflow.com/questions/14689397/listbox-with-auto-sizing-horizontal-scroll-bar
		Dim needScrollWidth As Integer = 0
		Dim checkVal As Integer = 0
		Dim myString As String

		If Count > 0 Then
			Using widthFinder As Graphics = MyBase.CreateGraphics()
				For i As Integer = 0 To Count - 1
					myString = GetItemStringByIndex(i)

					checkVal = widthFinder.MeasureString(myString, BoldFont).Width + 1
					If needScrollWidth < checkVal Then
						needScrollWidth = checkVal
					End If
				Next
			End Using
		End If

		MyBase.HorizontalScrollbar = True
		MyBase.HorizontalExtent = needScrollWidth
		MyBase.ColumnWidth = needScrollWidth
	End Sub

	'http://www.bobpowell.net/lockingbits.htm
	Private Function MeasureDisplayStringWidth(phrase As TextSegment, workingFont As Font, myBrush As Brush, myBounds As Rectangle) As Integer
		Dim myNewBounds As New Rectangle(myBounds.X, 0, myBounds.Width, myBounds.Height)
		Using myBitmap As New Bitmap(Screen.AllScreens.Sum(Function(x As Screen) x.WorkingArea.Width), myBounds.Height, Imaging.PixelFormat.Format32bppArgb)
			Using myGraphic As Graphics = Graphics.FromImage(myBitmap)
				myGraphic.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
				myGraphic.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
				myGraphic.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality

				myGraphic.DrawString(phrase.Text, workingFont, myBrush, myNewBounds, StringFormat.GenericDefault)
				myGraphic.Flush()
			End Using

			Dim bitmapData As Imaging.BitmapData = myBitmap.LockBits(New Rectangle(0, 0, myBitmap.Width, myBitmap.Height), Imaging.ImageLockMode.ReadOnly, myBitmap.PixelFormat)

			Dim size As Integer = Math.Abs(bitmapData.Stride) * bitmapData.Height
			Dim data(size - 1) As Byte

			Marshal.Copy(bitmapData.Scan0, data, 0, size)

			Dim pixelArray(myBitmap.Height)() As Byte

			'we have to load all the opacity pixels into an array for later scanning by column
			'the data comes in rows
			For y = myBitmap.Height - 1 To 0 Step -1
				Dim rowArray(bitmapData.Stride) As Byte
				Array.Copy(data, y * bitmapData.Stride, rowArray, 0, bitmapData.Stride)
				'For x = myBitmap.Width - 1 To 0 Step -1
				'	Dim i = (y * bitmapData.Stride) + (x * 4)
				'	Dim B = data(i)
				'	Dim G = data(i + 1)
				'	Dim R = data(i + 2)
				'	Dim A = data(i + 3)
				'Next
				pixelArray(y) = rowArray
			Next

			'scan by column for the last pixel containing data
			For x = bitmapData.Stride - 1 To 0 Step -1
				For y = myBitmap.Height - 1 To 0 Step -1
					If pixelArray(y)(x) > 0 Then 'that is, it contains data
						'divide by 4, because there are 4 bytes per pixel
						'floor makes sure we always return the current pixel instead of jumping to the next pixel by rounding up
						Return Math.Floor(x / 4)
					End If
				Next
			Next

		End Using

		Return 0

	End Function

	Private Function GetItemStringByIndex(Index As Integer) As String
		Dim returnString As String

		'get the correct string based on whether we are working with a DataSource or not
		'we are using explicit MyBase.DataSource references here because of the variety of actions that must be taken based on the results
		'the aggregate Count function won't allow us to be this precise
		If MyBase.DataSource IsNot Nothing AndAlso Not String.IsNullOrWhiteSpace(MyBase.DisplayMember) AndAlso MyBase.DataSource.Count > 0 Then
			Dim myPropInfo As PropertyInfo = MyBase.DataSource(Index).GetType.GetProperty(MyBase.DisplayMember)
			returnString = myPropInfo.GetValue(MyBase.DataSource(Index), Nothing)
		ElseIf MyBase.Items.Count > 0 AndAlso Index < MyBase.Items.Count AndAlso Index > -1 Then
			returnString = MyBase.Items(Index).ToString
		Else
			returnString = String.Empty
		End If

		Return returnString
	End Function

End Class
